home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok46.lha / Programme / SternSimulation.mod < prev    next >
Text File  |  1993-08-15  |  27KB  |  883 lines
  1. (*
  2.  * -------------------------------------------------------------------------
  3.  *
  4.  *    :Program.    SternSimulation
  5.  *    :Contents.    Simulation von Gravitationskräften.
  6.  *    :Author.    Reiner Nix
  7.  *    :Address.    Geranienhof 2, 5000 Köln 71 Seeberg
  8.  *    :Copyright.    Public Domain
  9.  *    :Language.    Modula-2
  10.  *    :Translator.    M2Amiga A-L V3.3d
  11.  *    :History.    V1.0    21.11.90
  12.  *    :Imports.    IntuitionTools,        siehe diese Diskette
  13.  *    :Imports.    AmigaGraphik,        siehe diese Diskette
  14.  *    :Imports.    IntuitionTools,        siehe diese Diskette
  15.  *
  16.  * -------------------------------------------------------------------------
  17.  *)
  18. MODULE SternSimulation;
  19.  
  20. FROM    SYSTEM        IMPORT    ADR, LONGSET;
  21. FROM    Arts        IMPORT    Assert, TermProcedure, Requester;
  22. FROM    Exec        IMPORT    UByte, Byte,
  23.                                 Wait, GetMsg, ReplyMsg;
  24. FROM    Layers        IMPORT    ScrollLayer;
  25. FROM    Graphics    IMPORT  FontStyles, FontStyleSet,
  26.                 FontFlags, FontFlagSet,
  27.                 TextFontPtr, BitMapPtr,
  28.                 TextAttr;
  29. FROM    Intuition    IMPORT    customScreen, gzzGadget, maxBody,
  30.                 IDCMPFlags, IDCMPFlagSet,
  31.                 WindowFlags, WindowFlagSet,
  32.                 GadgetFlags, GadgetFlagSet,
  33.                 PropInfoFlags, PropInfoFlagSet,
  34.                 ActivationFlags, ActivationFlagSet,
  35.                 WindowPtr, ScreenPtr, IntuiMessagePtr,
  36.                 NewScreen, NewWindow, IntuiMessage,
  37.                 AddGadget, RefreshGList,
  38.                 WindowToBack, WindowToFront,
  39.                 OpenWorkBench, CloseWorkBench;
  40. FROM    IntuitionTools    IMPORT    GraphMode, XrelBreite, YrelHoehe,
  41.                 relBreite, relHoehe,
  42.                 initNewScreen, initNewWindow, initTextAttr,
  43.                 initPropInfo, openBitMap,
  44.                 selectGadget, deselectGadget,
  45.                 enableGadgets, disableGadgets,
  46.                 refreshOneGadget;
  47. FROM    AmigaGraphik    IMPORT    OpenScreen, CloseScreen, UseScreen,
  48.                 OpenWindow,CloseWindow, UseWindow,
  49.                 OpenFont, CloseFont, UseFont,
  50.                 SetColourReg, SetAPen, SetBPen,
  51.                 Move, WriteString, WriteCard, WriteInt,
  52.                 WritePixel, FillRectangle;
  53. FROM    IntuitionObjekte IMPORT ObjektTyp, BooleanTyp, ObjektEreignis,
  54.                 ObjektPtr,
  55.                 ObjektAktion, PruefeEingabe,
  56.                 setzeTextFarbe, setzeLinienFarbe,
  57.                 setzeRandFarbe, setzeEingabeFarbe,
  58.                 setzeAusrichtung, setzeGadgetTyp,
  59.                 setzeHPosition, setzeVPosition,
  60.                 erzeugeBooleanObjekt,
  61.                 erzeugeTextObjekt,
  62.                 erzeugeRealObjekt,
  63.                 erzeugeHPropObjekt, erzeugeVPropObjekt,
  64.                 findeObjekt, verbindeObjekte,
  65.                 verarbeiteNachricht,
  66.                 frageGadget, frageObjektNr, EingabeOk,
  67.                 aenderInfoSatz, erneuerObjekte,
  68.                 frageHPosition, frageVPosition,
  69.                 loescheAlleObjekte;
  70. FROM    MathLib0    IMPORT    sqrt;
  71.  
  72. CONST    maxName        =21;
  73.     maxKoerper    =12;
  74.     xSchirmMax    =640;
  75.     ySchirmMax    =256;
  76.     superBreite    =704;
  77.     superHoehe    =512;
  78.     SchirmTitel    ="Sternsimulation V1.0";
  79.     EingabeTitel    ="Eingabefenster";
  80.     AusgabeTitel    ="Ausgabefenster";
  81.     keinSchirm    ="Schlag mich! Konnte Schirm nicht öffnen.";
  82.     keinFenster    ="Tritt mich! Konnte Fenster nicht öffnen.";
  83.     keineBitMap    ="keine BitMap DA";
  84.  
  85.     NameID        = 1;
  86.     PosID        = 2;
  87.     aID        = 5;
  88.     vID        = 8;
  89.     MasseID        =11;
  90.     ZeitID        =12;
  91.     ZoomID        =13;
  92.     FarbeID        =13;        (* Farbe+1 .. FarbeID+maxKoerper *)
  93.     SimuID        =1000;
  94.     LoeschenID    =1001;
  95.     NeuID        =1004;
  96.     KoerperID    =2004;
  97.     AktivID        =2024;
  98.  
  99.     HochID        = 1;
  100.     BreitID        = 2;
  101.  
  102.     g        =6.67E-11;
  103.  
  104.  
  105. TYPE    TName        =ARRAY [1..maxName+2] OF CHAR;
  106.  
  107.     Vektor        =RECORD x, y, z        :REAL
  108.                 END;
  109.  
  110.     TKoerper    =RECORD Name        :TName;
  111.                 Position,
  112.                 AltPosition,
  113.                 Geschwindigkeit,
  114.                 Beschleunigung    :Vektor;
  115.                 Masse        :REAL;
  116.                 Farbe        :INTEGER;
  117.                 Aktiv        :BOOLEAN
  118.                 END;
  119.  
  120.  
  121. VAR    Bildschirm        :ScreenPtr;
  122.     EingabeFenster,
  123.     AusgabeFenster        :WindowPtr;
  124.     Times18, Topaz8        :TextFontPtr;
  125.     Koerper            :ARRAY [0..maxKoerper] OF TKoerper;
  126.     Planet            :INTEGER;
  127.     t, Zoom, altZoom    :REAL;
  128.     rechnenAn        :BOOLEAN;
  129.     xAlt, yAlt        :CARDINAL;
  130.  
  131.  
  132.  
  133. PROCEDURE CleanUp;
  134.  
  135. BEGIN
  136. loescheAlleObjekte (EingabeFenster);
  137. loescheAlleObjekte (AusgabeFenster);
  138. IF Times18 # Topaz8 THEN
  139.   CloseFont (Times18)
  140.   END;
  141. CloseFont (Topaz8);
  142. CloseWindow (AusgabeFenster);
  143. CloseWindow (EingabeFenster);
  144. CloseScreen (Bildschirm);
  145. IF OpenWorkBench () # NIL THEN            (* Ergebnis unnötig *)
  146.   END
  147. END CleanUp;
  148.  
  149.  
  150. PROCEDURE LoescheAusgabe;
  151.  
  152. BEGIN
  153. UseWindow (AusgabeFenster);
  154. SetAPen (14);
  155. FillRectangle (0,0, 3000,3000)
  156. END LoescheAusgabe;
  157.  
  158.  
  159. PROCEDURE LoescheAktion        (    Ereignis        :ObjektEreignis;
  160.                      objekt        :ObjektPtr);
  161.  
  162. BEGIN
  163. LoescheAusgabe
  164. END LoescheAktion;
  165.  
  166.  
  167. PROCEDURE SystemAnpassen;
  168.  
  169. (* Aufgabe:    Bildschirm öffnen, Farben einstellen,
  170.  *        EingabeFenster und AusgabeFenster öffnen
  171.  *)
  172.  
  173. VAR    neuSchirm    :NewScreen;
  174.     neuFenster    :NewWindow;
  175.     BitMap        :BitMapPtr;
  176.     Attribute    :TextAttr;
  177.  
  178. BEGIN
  179. Bildschirm := NIL;
  180. EingabeFenster := NIL;
  181. AusgabeFenster := NIL;
  182. Times18 := NIL;
  183. Topaz8 := NIL;
  184. TermProcedure (CleanUp);
  185.  
  186. IF CloseWorkBench () THEN            (* Ergebnis unnötig *)
  187.   END;
  188. initNewScreen (neuSchirm,
  189.                0,0, xSchirmMax,ySchirmMax,
  190.                4, 1,14, HiRes,
  191.                customScreen,
  192.                NIL,                (* Font *)
  193.                ADR (SchirmTitel));
  194. Bildschirm := OpenScreen (neuSchirm);
  195. Assert (Bildschirm # NIL, ADR (keinSchirm));
  196. UseScreen (Bildschirm);
  197. SetColourReg ( 0, 0666H);
  198. SetColourReg ( 1, 0FFFH);
  199. SetColourReg ( 2, 0B60H);
  200. SetColourReg ( 3, 0480H);
  201. SetColourReg ( 4, 0FF0H);
  202. SetColourReg ( 5, 0851H);
  203. SetColourReg ( 6, 0988H);
  204. SetColourReg ( 7, 000FH);
  205. SetColourReg ( 8, 0F00H);
  206. SetColourReg ( 9, 0F0FH);
  207. SetColourReg (10, 0EA9H);
  208. SetColourReg (11, 0966H);
  209. SetColourReg (12, 0357H);
  210. SetColourReg (13, 0868H);
  211. SetColourReg (14, 0000H);
  212. SetColourReg (15, 0F80H);
  213. BitMap := openBitMap (superBreite, superHoehe, 4);
  214. Assert (BitMap # NIL, ADR (keineBitMap));
  215. initNewWindow (neuFenster,
  216.                240,10, 400,246,
  217.                14, 1,
  218.                IDCMPFlagSet {newSize, sizeVerify},
  219.                WindowFlagSet {windowDepth, windowSizing, windowDrag,
  220.                               sizeBRight, sizeBBottom,
  221.                               superBitMap, gimmeZeroZero, noCareRefresh},
  222.                NIL, NIL,
  223.                ADR (AusgabeTitel),
  224.                Bildschirm,
  225.                BitMap,
  226.                170,50, -1,-1,
  227.                customScreen);
  228. AusgabeFenster := OpenWindow (neuFenster);
  229. Assert (AusgabeFenster # NIL, ADR (keinFenster));
  230. initNewWindow (neuFenster,
  231.                0,10, 640,246,
  232.                14, 1,
  233.                IDCMPFlagSet {closeWindow},
  234.                WindowFlagSet {windowDepth, windowClose, noCareRefresh},
  235.                NIL,                (* kein Gadget *)
  236.                NIL,                (* keine CheckMark *)
  237.                ADR (EingabeTitel),
  238.                Bildschirm,
  239.                NIL,
  240.                0,0, 0,0,            (* min, max *)
  241.                customScreen);
  242. EingabeFenster := OpenWindow (neuFenster);
  243. Assert (EingabeFenster # NIL, ADR (keinFenster));
  244. LoescheAusgabe;
  245. initTextAttr (Attribute,
  246.               ADR ("topaz.font"), 8, FontStyleSet {}, FontFlagSet {});
  247. Topaz8 := OpenFont (Attribute);
  248. initTextAttr (Attribute,
  249.               ADR ("times.font"), 18, FontStyleSet {}, FontFlagSet {});
  250. Times18 := OpenFont (Attribute);
  251. IF Times18 = NIL THEN
  252.   Assert (Requester ( ADR (SchirmTitel),
  253.                       ADR ("Zeichensatz Times.18 nicht gefunden"),
  254.                       ADR ("nimm Topaz.8"), ADR ("Programm abbrechen")),
  255.            ADR ("Programmstop!"));
  256.   Times18 := Topaz8
  257.   END
  258. END SystemAnpassen;
  259.  
  260.  
  261. PROCEDURE WerteEinstellen;
  262.  
  263. VAR    i        :CARDINAL;
  264.  
  265.  
  266. BEGIN
  267. WITH Koerper[1] DO
  268.   Name            := "Sonne               ";
  269.   Position.x        := 0.0;
  270.   Position.y        := 0.0;
  271.   Position.z        := 0.0;
  272.   Geschwindigkeit    := Position;
  273.   Beschleunigung    := Position;
  274.   Masse            := 1.985E30;
  275.   Farbe            := 4;
  276.   END;
  277. FOR i := 2 TO maxKoerper DO
  278.   Koerper[i]        := Koerper[1];
  279.   Koerper[i].Farbe    := i+3
  280.   END;
  281. WITH Koerper[2] DO
  282.   Name            := "Merkur              ";
  283.   Position.y        := 5.79E10;
  284.   Geschwindigkeit.x    := 4.79E4;
  285.   Masse            := 3.169E23
  286.   END;
  287. WITH Koerper[3] DO
  288.   Name            := "Venus               ";
  289.   Position.y        := 1.08E11;
  290.   Geschwindigkeit.x    := 3.50E4;
  291.   Masse            := 4.873E24
  292.   END;
  293. WITH Koerper[4] DO
  294.   Name            := "Erde                ";
  295.   Position.y        := 1.496E11;
  296.   Geschwindigkeit.x    := 2.978E4;
  297.   Masse            := 5.979E24
  298.   END;
  299. WITH Koerper[5] DO
  300.   Name            := "Mars                ";
  301.   Position.y        := 2.279E11;
  302.   Geschwindigkeit.x    := 2.41E4;
  303.   Masse            := 6.398E23
  304.   END;
  305. WITH Koerper[6] DO
  306.   Name            := "Jupiter  (Jupp)     ";
  307.   Position.y        := 7.78E11;
  308.   Geschwindigkeit.x    := 1.31E4;
  309.   Masse            := 1.901E27
  310.   END;
  311. WITH Koerper[7] DO
  312.   Name            := "Saturn              ";
  313.   Position.y        := 1.427E12;
  314.   Geschwindigkeit.x    := 9.6E3;
  315.   Masse            := 5.693E26
  316.   END;
  317. WITH Koerper[8] DO
  318.   Name            := "Uranus              ";
  319.   Position.y        := 2.870E12;
  320.   Geschwindigkeit.x    := 6.8E3;
  321.   Masse            := 8.699E25
  322.   END;
  323. WITH Koerper[9] DO
  324.   Name            := "Neptun              ";
  325.   Position.y        := 4.496E12;
  326.   Geschwindigkeit.x    := 5.4E3;
  327.   Masse            := 1.030E26;
  328.   END;
  329. WITH Koerper[10] DO
  330.   Name            := "Pluto               ";
  331.   Position.y        := 5.946E12;
  332.   Geschwindigkeit.x    := 4.7E3;
  333.   Masse            := 2.319E22
  334.   END;
  335. FOR i := 11 TO maxKoerper DO
  336.   WITH Koerper[i] DO
  337.     Name := "                    ";
  338.     Masse := 0.0
  339.     END
  340.   END;
  341. FOR i := 1 TO maxKoerper DO
  342.   WITH Koerper[i] DO
  343.     AltPosition := Position;
  344.     Aktiv := (Masse # 0.0)
  345.     END
  346.   END;
  347. Planet         := 4;
  348. Koerper[0]    := Koerper[Planet];
  349. t        := 86400.0;
  350. Zoom        := 2.0E9;
  351. altZoom        := Zoom
  352. END WerteEinstellen;
  353.  
  354.  
  355. PROCEDURE StartStopAktion    (    Ereignis        :ObjektEreignis;
  356.                      objekt        :ObjektPtr);
  357.  
  358. BEGIN
  359. rechnenAn := NOT rechnenAn;
  360. IF rechnenAn THEN
  361.   Koerper[0].Aktiv := Koerper[Planet].Aktiv;
  362.   Koerper[Planet] := Koerper[0];
  363.   aenderInfoSatz (findeObjekt (EingabeFenster, Planet+KoerperID),
  364.             Koerper[Planet].Name);
  365.   objekt := findeObjekt (EingabeFenster, SimuID);
  366.   aenderInfoSatz (objekt , "    Halt an!    ");
  367.   selectGadget (EingabeFenster, frageGadget (objekt));
  368.   objekt := findeObjekt (AusgabeFenster, SimuID);
  369.   aenderInfoSatz (objekt , "    Halt an!    ");
  370.   selectGadget (AusgabeFenster, frageGadget (objekt));
  371.   disableGadgets (EingabeFenster,
  372.                   LONGSET {NameID..MasseID, FarbeID+1..FarbeID+maxKoerper});
  373.   WindowToFront (AusgabeFenster);
  374. ELSE
  375.   objekt := findeObjekt (EingabeFenster, SimuID);
  376.   aenderInfoSatz (objekt , "  Mach weiter!  ");
  377.   deselectGadget (EingabeFenster, frageGadget (objekt));
  378.   objekt := findeObjekt (AusgabeFenster, SimuID);
  379.   aenderInfoSatz (objekt , "  Mach weiter!  ");
  380.   deselectGadget (AusgabeFenster, frageGadget (objekt));
  381.   enableGadgets (EingabeFenster,
  382.                  LONGSET {NameID..MasseID, FarbeID+1..FarbeID+maxKoerper});
  383.   Koerper[0] := Koerper[Planet];
  384.   erneuerObjekte (EingabeFenster, LONGSET {NameID..MasseID});
  385.   WindowToFront (EingabeFenster);
  386.   END
  387. END StartStopAktion;
  388.  
  389.  
  390. PROCEDURE KoerperAktion        (    Ereignis        :ObjektEreignis;
  391.                      objekt        :ObjektPtr);
  392.  
  393. VAR    alt        :ObjektPtr;
  394.     neuPlanet    :INTEGER;
  395.  
  396.  
  397. BEGIN
  398. IF frageObjektNr (objekt) # Planet+KoerperID THEN
  399.   alt := findeObjekt (EingabeFenster, Planet+KoerperID);
  400.   deselectGadget (EingabeFenster,
  401.                   frageGadget (alt));
  402.   selectGadget (EingabeFenster, frageGadget (objekt));
  403.   IF NOT (rechnenAn) THEN
  404.     Koerper[0].Aktiv := Koerper[Planet].Aktiv;
  405.     Koerper[Planet] := Koerper[0]
  406.     END;
  407.   aenderInfoSatz (alt, Koerper[Planet].Name)
  408.   END;
  409.  
  410. neuPlanet := frageObjektNr (objekt)-KoerperID;
  411. IF Koerper[Planet].Farbe # Koerper[neuPlanet].Farbe THEN
  412.   aenderInfoSatz ( findeObjekt (EingabeFenster,
  413.                                 Koerper[Planet].Farbe-3+FarbeID), "   ");
  414.   aenderInfoSatz ( findeObjekt (EingabeFenster,
  415.                       Koerper[neuPlanet].Farbe-3+FarbeID), " * ")
  416.   END;
  417. IF (Planet = neuPlanet) AND (Koerper[Planet].Masse = 0.0)
  418.    AND Koerper[Planet].Aktiv THEN
  419.   Koerper[Planet].Aktiv := FALSE;
  420.   aenderInfoSatz ( findeObjekt (EingabeFenster, Planet+AktivID), "   ")
  421.   END;
  422. Planet := neuPlanet;
  423. Koerper[0] := Koerper[Planet];
  424. erneuerObjekte (EingabeFenster, LONGSET {NameID..MasseID})
  425. END KoerperAktion;
  426.  
  427.  
  428. PROCEDURE UrAktion        (    Ereignis        :ObjektEreignis;
  429.                      objekt        :ObjektPtr);
  430.  
  431. VAR    i        :INTEGER;
  432.     Text        :ARRAY [1..maxName+2] OF CHAR;
  433.  
  434. BEGIN
  435. aenderInfoSatz ( findeObjekt (EingabeFenster,
  436.                               Koerper[Planet].Farbe-3+FarbeID), "   ");
  437. deselectGadget (EingabeFenster,
  438.                 frageGadget (findeObjekt (EingabeFenster, Planet+KoerperID)));
  439. WerteEinstellen;
  440. aenderInfoSatz ( findeObjekt (EingabeFenster,
  441.                               Koerper[Planet].Farbe-3+FarbeID), " * ");
  442. selectGadget (EingabeFenster,
  443.               frageGadget (findeObjekt (EingabeFenster, Planet+KoerperID)));
  444. erneuerObjekte (EingabeFenster, LONGSET {NameID..ZoomID});
  445. FOR i := 1 TO maxKoerper DO
  446.   aenderInfoSatz (findeObjekt (EingabeFenster, i+KoerperID), Koerper[i].Name);
  447.   IF Koerper[i].Aktiv THEN
  448.     aenderInfoSatz ( findeObjekt (EingabeFenster, AktivID+i), " * ")
  449.   ELSE
  450.     aenderInfoSatz ( findeObjekt (EingabeFenster, AktivID+i), "   ")
  451.     END
  452.   END;
  453. LoescheAusgabe
  454. END UrAktion;
  455.  
  456.  
  457. PROCEDURE AktivAktion        (    Ereignis        :ObjektEreignis;
  458.                      objekt        :ObjektPtr);
  459.  
  460. VAR    i    :INTEGER;
  461.  
  462. BEGIN
  463. i := frageObjektNr (objekt) - AktivID;
  464. IF Koerper[i].Aktiv THEN
  465.   Koerper[i].Aktiv := FALSE;
  466.   aenderInfoSatz (objekt, "   ")
  467. ELSIF ((Planet = i) AND (Koerper[0].Masse # 0.0)) OR
  468.       ((Planet # i) AND (Koerper[i].Masse # 0.0)) THEN
  469.   Koerper[i].Aktiv := TRUE;
  470.   aenderInfoSatz (objekt, " * ")
  471.   END
  472. END AktivAktion;
  473.  
  474.  
  475. PROCEDURE FarbAktion        (    Ereignis        :ObjektEreignis;
  476.                      objekt        :ObjektPtr);
  477.  
  478. BEGIN
  479. WITH Koerper[0] DO
  480.   IF Farbe # (frageObjektNr (objekt)+3 - FarbeID) THEN
  481.     aenderInfoSatz (findeObjekt (EingabeFenster, Farbe-3 + FarbeID), "   ");
  482.     Koerper[0].Farbe := frageObjektNr (objekt)+3 - FarbeID;
  483.     aenderInfoSatz (objekt, " * ")
  484.     END
  485.   END
  486. END FarbAktion;
  487.  
  488.  
  489. PROCEDURE pruefeMasse        (    objekt        :ObjektPtr) :BOOLEAN;
  490.  
  491. BEGIN
  492. WITH Koerper[0] DO
  493.   IF (Masse = 0.0) AND Koerper[Planet].Aktiv THEN
  494.     Koerper[Planet].Aktiv := FALSE;
  495.     aenderInfoSatz (findeObjekt (EingabeFenster, Planet+AktivID), "   ")
  496.     END;
  497.   RETURN Masse >= 0.0
  498.   END
  499. END pruefeMasse;
  500.  
  501.  
  502. PROCEDURE pruefeZeit        (    objekt             :ObjektPtr) :BOOLEAN;
  503.  
  504. BEGIN
  505. RETURN (t > 0.0)
  506. END pruefeZeit;
  507.  
  508.  
  509. PROCEDURE pruefeZoom        (    objekt        :ObjektPtr) :BOOLEAN;
  510.  
  511. BEGIN
  512. IF (Zoom # altZoom) AND (Zoom > 0.0) THEN
  513.   LoescheAusgabe;
  514.   altZoom := Zoom
  515.   END;
  516. RETURN (Zoom > 0.0)
  517. END pruefeZoom;
  518.  
  519.  
  520. PROCEDURE HochAktion        (    Ereignis        :ObjektEreignis;
  521.                      objekt        :ObjektPtr);
  522.  
  523. VAR    y    :CARDINAL;
  524.  
  525. BEGIN
  526. y := CARDINAL ((LONGCARD (frageVPosition (objekt)) *
  527.                 LONGCARD (superHoehe - AusgabeFenster^.gzzHeight)) DIV
  528.                  maxBody);
  529. IF y # yAlt THEN
  530.   ScrollLayer (AusgabeFenster^.wLayer, 0, LONGINT (y)-LONGINT (yAlt));
  531.   yAlt := y
  532.   END
  533. END HochAktion;
  534.  
  535.  
  536. PROCEDURE BreitAktion        (    Ereignis        :ObjektEreignis;
  537.                      objekt        :ObjektPtr);
  538.  
  539. VAR    x    :CARDINAL;
  540.  
  541. BEGIN
  542. x := CARDINAL ((LONGCARD (frageHPosition (objekt)) *
  543.                 LONGCARD (superBreite-AusgabeFenster^.gzzWidth)) DIV
  544.                  maxBody);
  545. IF x # xAlt THEN
  546.   ScrollLayer (AusgabeFenster^.wLayer, LONGINT (x)-LONGINT (xAlt), 0);
  547.   xAlt := x
  548.   END
  549. END BreitAktion;
  550.  
  551.  
  552. PROCEDURE EingabeErzeugen;
  553.  
  554. VAR    i            :INTEGER;
  555.     Text            :ARRAY [1..maxName+1] OF CHAR;
  556.     objekt            :ObjektPtr;
  557.  
  558. BEGIN
  559. UseWindow (EingabeFenster);
  560. UseFont (Times18);
  561. SetAPen (1);
  562. Move ( 25,35); WriteString ("Himmelskörper");
  563. Move (185,35); WriteString ("Aktiv");
  564.  
  565. setzeLinienFarbe  (15,-1);
  566. setzeRandFarbe (14, -1);
  567. FOR i := 1 TO maxKoerper DO
  568.   setzeTextFarbe ( 1,  0);
  569.   erzeugeBooleanObjekt (EingabeFenster,  23,30+i*10, Koerper[i].Name,
  570.               i+KoerperID, melden, KoerperAktion);
  571.   IF i = Planet THEN
  572.     selectGadget (EingabeFenster,
  573.                   frageGadget (findeObjekt (EingabeFenster, Planet+KoerperID)))
  574.     END;
  575.   setzeTextFarbe ( 1, 8);
  576.   IF Koerper[i].Masse # 0.0 THEN
  577.     Koerper[i].Aktiv := TRUE;
  578.     erzeugeBooleanObjekt (EingabeFenster, 196,30+i*10, " * ", i+AktivID,
  579.                           melden, AktivAktion)
  580.   ELSE
  581.     erzeugeBooleanObjekt (EingabeFenster, 196,30+i*10, "   ", i+AktivID,
  582.                           melden, AktivAktion)
  583.     END
  584.   END;
  585.  
  586. setzeTextFarbe ( 1, 0);
  587. erzeugeRealObjekt (EingabeFenster, 143,170, "Zeitdifferenz:", ZeitID, -120,0,
  588.                    10,3, TRUE, pruefeZeit ,t);
  589. erzeugeRealObjekt (EingabeFenster, 143,185, "Zoomfaktor:   ", ZoomID, -120,0,
  590.                    10,3, TRUE, pruefeZoom, Zoom);
  591. erzeugeBooleanObjekt (EingabeFenster, 50,205, "   Urzustand    ", NeuID,
  592.                       melden, UrAktion);
  593. erzeugeBooleanObjekt (EingabeFenster, 50,215, " lösche Ausgabe ", LoeschenID,
  594.                       melden, LoescheAktion);
  595. erzeugeBooleanObjekt (EingabeFenster, 50,225, "    Fang an!    ", SimuID,
  596.                       melden, StartStopAktion);
  597.  
  598. erzeugeRealObjekt (EingabeFenster, 490,170, "Masse:", MasseID, -184,0,
  599.                    15,5, TRUE, pruefeMasse, Koerper[0].Masse);
  600.  
  601. erzeugeRealObjekt (EingabeFenster, 490,152, "                 z:", vID+2,-184,0,
  602.                    15,5, TRUE, EingabeOk, Koerper[0].Geschwindigkeit.z);
  603. erzeugeRealObjekt (EingabeFenster, 490,141, "                 y:", vID+1,-184,0,
  604.                    15,5, TRUE, EingabeOk, Koerper[0].Geschwindigkeit.y);
  605. erzeugeRealObjekt (EingabeFenster, 490,130, "Geschwindigkeit  x:", vID  ,-184,0,
  606.                    15,5, TRUE, EingabeOk, Koerper[0].Geschwindigkeit.x);
  607.  
  608. erzeugeRealObjekt (EingabeFenster, 490,112, "                 z:", aID+2,-184,0,
  609.                    15,5, TRUE, EingabeOk, Koerper[0].Beschleunigung.z);
  610. erzeugeRealObjekt (EingabeFenster, 490,101, "                 y:", aID+1,-184,0,
  611.                    15,5, TRUE, EingabeOk, Koerper[0].Beschleunigung.y);
  612. erzeugeRealObjekt (EingabeFenster, 490, 90, "Beschleunigung   x:", aID  ,-184,0,
  613.                    15,5, TRUE, EingabeOk, Koerper[0].Beschleunigung.x);
  614.  
  615. erzeugeRealObjekt (EingabeFenster, 490, 72, "                 z:",PosID+2,-184,0,
  616.                    15,5, TRUE, EingabeOk, Koerper[0].Position.z);
  617. erzeugeRealObjekt (EingabeFenster, 490, 61, "                 y:",PosID+1,-184,0,
  618.                    15,5, TRUE, EingabeOk, Koerper[0].Position.y);
  619. erzeugeRealObjekt (EingabeFenster, 490, 50, "Position         x:",PosID  ,-184,0,
  620.                    15,5, TRUE, EingabeOk, Koerper[0].Position.x);
  621.  
  622. erzeugeTextObjekt (EingabeFenster, 370, 30, "Name:", NameID, -64,0,
  623.                    maxName, maxName, EingabeOk, Koerper[0].Name);
  624.  
  625. Move (306, 220); UseFont (Topaz8);
  626. WriteString ("Farbe:");
  627. FOR i := 1 TO maxKoerper DO
  628.   setzeTextFarbe (i+3, 1);
  629.   setzeRandFarbe (14, -1);
  630.   IF Koerper[0].Farbe = i+3 THEN
  631.     erzeugeBooleanObjekt (EingabeFenster, 306+(i-1)*26,225, " * ",FarbeID+i,
  632.                           melden, FarbAktion)
  633.   ELSE
  634.     erzeugeBooleanObjekt (EingabeFenster, 306+(i-1)*26,225, "   ",FarbeID+i,
  635.                           melden, FarbAktion)
  636.     END
  637.   END;
  638. setzeTextFarbe (1, 0);
  639. verbindeObjekte (EingabeFenster, NameID,  -1,      PosID,   -1, -1);
  640. verbindeObjekte (EingabeFenster, PosID,   NameID,  PosID+1, -1, -1);
  641. verbindeObjekte (EingabeFenster, PosID+1, PosID,   PosID+2, -1, -1);
  642. verbindeObjekte (EingabeFenster, PosID+2, PosID+1, aID,     -1, -1);
  643. verbindeObjekte (EingabeFenster, aID,     PosID+2, aID+1,   -1, -1);
  644. verbindeObjekte (EingabeFenster, aID+1,   aID,     aID+2,   -1, -1);
  645. verbindeObjekte (EingabeFenster, aID+2,   aID+1,   vID,     -1, -1);
  646. verbindeObjekte (EingabeFenster, vID,     aID+2,   vID+1,   -1, -1);
  647. verbindeObjekte (EingabeFenster, vID+1,   vID,     vID+2,   -1, -1);
  648. verbindeObjekte (EingabeFenster, vID+2,   vID+1,   MasseID, -1, -1);
  649. verbindeObjekte (EingabeFenster, MasseID, vID+2,   -1,      -1, -1);
  650. verbindeObjekte (EingabeFenster, ZeitID,  -1,      ZoomID,  -1, -1);
  651. verbindeObjekte (EingabeFenster, ZoomID,  ZeitID,  -1,      -1, -1);
  652. rechnenAn := FALSE;
  653.  
  654. setzeGadgetTyp (gzzGadget);
  655. setzeAusrichtung ( GadgetFlagSet {YrelHoehe});
  656. erzeugeBooleanObjekt (AusgabeFenster, 4,-8, "    Fang an!    ", SimuID,
  657.                       melden, StartStopAktion);
  658. setzeAusrichtung ( GadgetFlagSet {YrelHoehe, relBreite});
  659. erzeugeHPropObjekt (AusgabeFenster, 134,-8, -153, 8,
  660.                     maxBody DIV 2,
  661.                     CARDINAL (maxBody * LONGCARD (AusgabeFenster^.gzzWidth) DIV
  662.                      superBreite),
  663.                     BreitID, wiederholen, BreitAktion);
  664. setzeAusrichtung ( GadgetFlagSet {XrelBreite, relHoehe});
  665. erzeugeVPropObjekt (AusgabeFenster, -16,11, 16,-21,
  666.                     maxBody DIV 2,
  667.                     CARDINAL (maxBody * LONGCARD (AusgabeFenster^.gzzHeight) DIV
  668.                      superHoehe),
  669.                     HochID, wiederholen, HochAktion);
  670. setzeAusrichtung ( GadgetFlagSet {});
  671. setzeGadgetTyp (0);
  672. xAlt := (superBreite-AusgabeFenster^.gzzWidth) DIV 2;
  673. yAlt := (superHoehe-AusgabeFenster^.gzzHeight) DIV 2;
  674. ScrollLayer (AusgabeFenster^.wLayer, xAlt, yAlt);
  675. END EingabeErzeugen;
  676.  
  677.  
  678. (*----------------------------------------------------------------------------*)
  679.    PROCEDURE Zeichnen;
  680. (*----------------------------------------------------------------------------*)
  681. VAR    i    :INTEGER;
  682.     a,b    :REAL;
  683. BEGIN
  684.  FOR i := 1 TO maxKoerper DO
  685.   WITH Koerper[i] DO
  686.    IF Aktiv
  687.     THEN (*-- Zeichnen -------------------------------------------------------*)
  688.           a := (AltPosition.x / Zoom) * 2.0 + REAL (superBreite DIV 2);
  689.      b := AltPosition.y / Zoom + REAL (superHoehe DIV 2);
  690.      IF (a>0.0) AND (a<REAL(superBreite)) AND
  691.         (b>0.0) AND (b<REAL(superHoehe))
  692.       THEN SetAPen (Farbe);
  693.            WritePixel (INTEGER (a), INTEGER (b))
  694.      END; (* IF *)
  695.      a := (Position.x / Zoom) * 2.0 + REAL (superBreite DIV 2);
  696.      b := Position.y / Zoom + REAL (superHoehe DIV 2);
  697.      IF (a>0.0) AND (a<REAL(superBreite)) AND
  698.         (b>0.0) AND (b<REAL(superHoehe))
  699.       THEN SetAPen (8);
  700.            WritePixel (INTEGER (a), INTEGER (b))
  701.      END; (* IF *)
  702.      AltPosition := Position
  703.    END (* IF *)
  704.   END (* WITH Koerper[i] *)
  705.  END (* FOR i *)
  706. END Zeichnen;
  707.  
  708.  
  709. (*----------------------------------------------------------------------------*)
  710.    PROCEDURE Berechnung;
  711. (*----------------------------------------------------------------------------*)
  712. VAR    Dx, Dy, Dz, D, D2, A    :REAL;
  713.     K1, K2             :INTEGER;
  714.     Kollision        :BOOLEAN;
  715.     Text            :ARRAY [1..maxName+2] OF CHAR;
  716. BEGIN
  717.  UseWindow (AusgabeFenster);
  718.  Kollision := FALSE;
  719.  K1 := 1;
  720.  WHILE K1 <= maxKoerper DO
  721.   IF Koerper[K1].Aktiv
  722.    THEN WITH Koerper[K1] DO
  723.  
  724.         (*-- Beschleunigung berechnen ----------------------------------------*)
  725.  
  726.          WITH Beschleunigung DO
  727.           x := 0.0;
  728.        y := 0.0;
  729.        z := 0.0;
  730.      END; (* WITH *)
  731.  
  732.          K2 := 1;
  733.          WHILE K2 <= maxKoerper DO
  734.           IF (Koerper[K2].Aktiv) AND (K2 # K1)
  735.            THEN Dx := Koerper [K2].AltPosition.x - AltPosition.x;
  736.                 Dy := Koerper [K2].AltPosition.y - AltPosition.y;
  737.                 Dz := Koerper [K2].AltPosition.z - AltPosition.z;
  738.             D2 := ABS (Dx*Dx + Dy*Dy + Dz*Dz);
  739.             D  := sqrt (D2);
  740.         IF D < 1.0
  741.          THEN Name := "Gesteinsbrocken";
  742.               Masse := Masse + Koerper[K2].Masse;
  743.               Geschwindigkeit.x := Geschwindigkeit.x +
  744.                              Koerper[K2].Geschwindigkeit.x;
  745.               Geschwindigkeit.y := Geschwindigkeit.y +
  746.                              Koerper[K2].Geschwindigkeit.y;
  747.               Geschwindigkeit.z := Geschwindigkeit.z +
  748.                              Koerper[K2].Geschwindigkeit.z;
  749.               aenderInfoSatz ( findeObjekt (EingabeFenster,
  750.                                KoerperID+K1), Name);
  751.               Koerper[K2].Name    := '';
  752.               Koerper[K2].Masse := 0.0;
  753.               Koerper[K2].Aktiv := FALSE;
  754.               aenderInfoSatz ( findeObjekt (EingabeFenster,
  755.                               KoerperID + K2), Koerper[K2].Name);
  756.               aenderInfoSatz ( findeObjekt (EingabeFenster,
  757.                             AktivID + K2) , "   ");
  758.               IF (Planet = K1) OR (Planet = K2)
  759.                THEN Koerper[0] := Koerper[Planet];
  760.                 erneuerObjekte (EingabeFenster,
  761.                                 LONGSET {NameID..MasseID})
  762.               END; (* IF *)
  763.               Kollision := TRUE;
  764.               K1     := maxKoerper;
  765.               K2    := maxKoerper
  766.          ELSE A := g * Koerper[K2].Masse / (D2 * D);
  767.                   WITH Beschleunigung DO
  768.                    x := x + A * Dx;
  769.                    y := y + A * Dy;
  770.                    z := z + A * Dz
  771.                   END (* WITH *)
  772.         END (* IF *)
  773.           END; (* IF *)
  774.           INC (K2)
  775.          END; (* WHILE *)
  776.  
  777.         (*-- Geschwindigkeit berechnen --------------------------------------*)
  778.  
  779.          WITH Geschwindigkeit DO
  780.           x := x + Beschleunigung.x * t;
  781.           y := y + Beschleunigung.y * t;
  782.           z := z + Beschleunigung.z * t
  783.          END; (* WITH Geschwindigkeit *)
  784.  
  785.         (*-- Position berechnen ---------------------------------------------*)
  786.  
  787.          WITH Position DO
  788.           x := AltPosition.x  + Geschwindigkeit.x * t;
  789.           y := AltPosition.y  + Geschwindigkeit.y * t;
  790.           z := AltPosition.z  + Geschwindigkeit.z * t;
  791.      END (* WITH Position *)
  792.  
  793.     END (* WITH Koerper[K1] *)
  794.   END; (* IF *)
  795.   INC (K1)
  796.  END; (* WHILE K1 *)
  797.  
  798.  IF NOT Kollision
  799.   THEN Zeichnen
  800.  END (* IF *)
  801. END Berechnung;
  802.  
  803.  
  804. PROCEDURE sieheEreignisse;
  805.  
  806. VAR     Ende, vergroessernAn    :BOOLEAN;
  807.     Signal            :LONGSET;
  808.     NachrichtPtr        :IntuiMessagePtr;
  809.     Nachricht        :IntuiMessage;
  810.  
  811.  
  812. PROCEDURE bearbeiteNachricht (    Fenster    :WindowPtr;
  813.                               VAR Nachricht    :IntuiMessage);
  814.  
  815. VAR    objekt        :ObjektPtr;
  816.  
  817. BEGIN
  818. verarbeiteNachricht (Fenster, Nachricht);
  819. WITH Nachricht DO
  820.   IF    sizeVerify IN class THEN
  821.     vergroessernAn := TRUE
  822.   ELSIF newSize IN class THEN
  823.     vergroessernAn := FALSE;
  824.     objekt := findeObjekt (AusgabeFenster, BreitID);
  825.     setzeHPosition (objekt, frageHPosition (objekt),
  826.                     CARDINAL (maxBody * LONGCARD (AusgabeFenster^.gzzWidth) DIV
  827.                      superBreite));
  828.     objekt := findeObjekt (AusgabeFenster, HochID);
  829.     setzeVPosition (objekt, frageVPosition (objekt),
  830.                     CARDINAL (maxBody * LONGCARD (AusgabeFenster^.gzzHeight) DIV
  831.                      superHoehe));
  832.     HochAktion (Start, findeObjekt (AusgabeFenster, HochID));
  833.     BreitAktion (Start, findeObjekt (AusgabeFenster, BreitID))
  834.   ELSIF closeWindow IN class THEN
  835.     Ende := TRUE
  836.   ELSE
  837.     END
  838.   END
  839. END bearbeiteNachricht;
  840.  
  841.  
  842. (* sieheEreignisse *)
  843. BEGIN
  844. UseWindow (AusgabeFenster);
  845. Ende := FALSE;
  846. vergroessernAn := FALSE;
  847. WHILE NOT Ende DO
  848.   IF rechnenAn THEN
  849.     IF NOT vergroessernAn THEN
  850.       Berechnung
  851.       END
  852.   ELSE
  853.     Signal := Wait (LONGSET {EingabeFenster^.userPort^.sigBit,
  854.                              AusgabeFenster^.userPort^.sigBit})
  855.     END;
  856.     REPEAT
  857.     NachrichtPtr := GetMsg (EingabeFenster^.userPort);
  858.     IF NachrichtPtr # NIL THEN
  859.       Nachricht := NachrichtPtr^;
  860.       ReplyMsg (NachrichtPtr);
  861.       bearbeiteNachricht (EingabeFenster, Nachricht)
  862.       END
  863.     UNTIL NachrichtPtr = NIL;
  864.     REPEAT
  865.     NachrichtPtr := GetMsg (AusgabeFenster^.userPort);
  866.     IF NachrichtPtr # NIL THEN
  867.       Nachricht := NachrichtPtr^;
  868.       ReplyMsg (NachrichtPtr);
  869.       bearbeiteNachricht (AusgabeFenster, Nachricht)
  870.       END
  871.     UNTIL NachrichtPtr = NIL
  872.   END
  873. END sieheEreignisse;
  874.  
  875.  
  876. (* HP *)
  877. BEGIN
  878. SystemAnpassen;
  879. WerteEinstellen;
  880. EingabeErzeugen;
  881. sieheEreignisse
  882. END SternSimulation.
  883.